home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / MEMSTAT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-25  |  6KB  |  174 lines
  1. UNIT MemStat;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Information about the system                  Last changed: 25.06.96  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-96 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. PROCEDURE MemoryStatus;
  16.  
  17. IMPLEMENTATION
  18.  
  19. USES Use32,
  20. {$IFNDEF NoOverlay}
  21.   Overlay,
  22. {$ENDIF}
  23. {$IFDEF DPMI}
  24.   Dpmi,
  25. {$ENDIF}
  26. {$IFDEF StackCheck}
  27.   OpStack,
  28. {$ENDIF}
  29.   OpCrt, OpWindow, OpString, ApTimer,
  30.   Ovrlay, PopTypes, OproUtil, Com, Globals, MTask;
  31.  
  32. {$IFDEF DPMI}
  33.   FUNCTION ProcessorTypes(Processor: Byte): S10;
  34.   BEGIN
  35.     CASE Processor OF
  36.       2  : ProcessorTypes:='80286';
  37.       3  : ProcessorTypes:='80386';
  38.       4  : ProcessorTypes:='80486';
  39.       ELSE ProcessorTypes:='Type '+Long2Str(Processor);
  40.     END;
  41.   END;
  42. {$ENDIF}
  43.  
  44.   FUNCTION OverlayBufLoc: S10;
  45.   BEGIN
  46.     CASE OverlayLocation OF
  47.       XMS  : OverlayBufLoc:='XMS';
  48.       EMS  : OverlayBufLoc:='EMS';
  49.       Disk : OverlayBufLoc:='Disk';
  50.       ELSE   OverlayBufLoc:='????';
  51.     END;
  52.   END;
  53.  
  54. {
  55.   DisplayType = (MonoHerc, CGA, MCGA, EGA, VGA, PGC);
  56.   HercCardType = (HercNone, HercPlain, HercPlus, HercInColor);
  57. }
  58.   FUNCTION ScrType(Display: DisplayType): S10;
  59.   BEGIN
  60.     CASE Display OF
  61.       MonoHerc : CASE WhichHerc OF
  62.                    HercNone    : ScrType:='Unknown';
  63.                    HercPlain   : ScrType:='Hercules';
  64.                    HercPlus    : ScrType:='Hercules+';
  65.                    HercInColor : ScrType:='InColor';
  66.                  END;
  67.       CGA      : ScrType:='CGA';
  68.       MCGA     : ScrType:='MCGA';
  69.       EGA      : ScrType:='EGA';
  70.       VGA      : ScrType:='VGA';
  71.       PGC      : ScrType:='PGC';
  72.     END;
  73.   END;
  74.  
  75.   PROCEDURE MemoryStatus;
  76.   TYPE
  77.     LiAry = Array[1..12] of LongInt;
  78.   VAR
  79.     MemWin : WindowPtr;
  80.     t      : EventTimer;
  81. {$IFDEF DPMI}
  82.     i        : Byte;
  83.     DPMIInfo : DPMIInfoRec;
  84.     MIR      : MemInfoRec;
  85. {$ENDIF}
  86. {$IFDEF StackCheck}
  87.     StackUsage : Word;
  88.     HeapUsage : LongInt;
  89.     FreeUsage : Word;
  90.     MemUsage : LongInt;
  91. {$ENDIF}
  92.   BEGIN
  93.     MyWin(MemWin,1,2,80,ScreenHeight,3,'System Information',False);
  94.     WITH MemWin^ DO
  95.     BEGIN
  96.       wFastText('Largest free block   :',2,2);
  97.       wFastWrite(LongIntForm('###.###.###',MaxAvail),2,27,Cfg.Color[3].FieldColor);
  98.       wFastText('Total free heap      :',3,2);
  99.       wFastWrite(LongIntForm('###.###.###',MemAvail),3,27,Cfg.Color[3].FieldColor);
  100. {$IFDEF Alpha}
  101.   {$IFNDEF NoOverlay}
  102.       wFastText('Start total free     :',4,2);
  103.       wFastWrite(LongIntForm('###.###.###',StartMemAvail),4,27,Cfg.Color[3].FieldColor);
  104.   {$ENDIF}
  105. {$ENDIF}
  106.       wFastText('Multitasker          :',5,2);
  107.       wFastWrite(LeftPad(MultiName(MultiTasker),11),5,27,Cfg.Color[3].FieldColor);
  108.  
  109. {$IFNDEF NoOverlay}
  110.       wFastText('Overlay buffer       :',7,2);
  111.       wFastWrite(LongIntForm('###.###.###',OvrGetBuf),7,27,Cfg.Color[3].FieldColor);
  112.       wFastText('Overlay load count   :',8,2);
  113.       wFastWrite(LongIntForm('###.###.###',OvrLoadCount),8,27,Cfg.Color[3].FieldColor);
  114.       wFastText('Overlay trap count   :',9,2);
  115.       wFastWrite(LongIntForm('###.###.###',OvrTrapCount),9,27,Cfg.Color[3].FieldColor);
  116.       wFastText('Probation area size  :',10,2);
  117.       wFastWrite(LongIntForm('###.###.###',OvrGetRetry),10,27,Cfg.Color[3].FieldColor);
  118.       wFastText('Overlay buffer loc.  :',11,2);
  119.       wFastWrite(LeftPad(OverlayBufLoc,11),11,27,Cfg.Color[3].FieldColor);
  120. {$ENDIF}
  121. {$IFDEF StackCheck}
  122.       CalcStackUsage(StackUsage, HeapUsage, FreeUsage, MemUsage);
  123.       wFastText('Stack usage          :',13,2);
  124.       wFastWrite(LongIntForm('###.###.###',StackUsage),13,27,Cfg.Color[3].FieldColor);
  125.       wFastText('Heap usage           :',14,2);
  126.       wFastWrite(LongIntForm('###.###.###',HeapUsage{$IFNDEF NoOverlay}-OvrGetBuf{$ENDIF}),14,27,Cfg.Color[3].FieldColor);
  127.       wFastText('Memory usage         :',15,2);
  128.       wFastWrite(LongIntForm('###.###.###',MemUsage),15,27,Cfg.Color[3].FieldColor);
  129. {$ENDIF}
  130.  
  131.       wFastText('Screen type          :',2,41);
  132.       wFastWrite(LeftPad(ScrType(CurrentDisplay),11),2,66,Cfg.Color[3].FieldColor);
  133.       wFastText('Screen dimensions    :',3,41);
  134.       wFastWrite(LeftPad(Long2Str(ScreenWidth)+'x'+Long2Str(ScreenHeight),11),3,66,Cfg.Color[3].FieldColor);
  135.       wFastText('Video segment        :',4,41);
  136.       wFastWrite(LeftPad('$'+HexW(VideoSegment),11),4,66,Cfg.Color[3].FieldColor);
  137.  
  138. {$IFDEF DPMI}
  139.       GetDPMIInfo(DPMIInfo);
  140.       wFastText('DPMI version         :',10,41);
  141.       wFastText('Processor            :',11,41);
  142.       WITH DPMIInfo DO
  143.       BEGIN
  144.         wFastWrite(LeftPad(Long2Str(MajorVersion)+'.'+Long2Str(MinorVersion),11),10,66,Cfg.Color[3].FieldColor);
  145.         wFastWrite(LeftPad(ProcessorTypes(Processor),11),11,66,Cfg.Color[3].FieldColor);
  146.       END;
  147.  
  148.       GetDPMIMemInfo(MIR);
  149.       wFastText('Largest free block   :',13,41);
  150.       wFastText('Max unlocked pages   :',14,41);
  151.       wFastText('Max locked pages     :',15,41);
  152.       wFastText('Linear Addr. pages   :',16,41);
  153.       wFastText('Total unlocked pages :',17,41);
  154.       wFastText('Total free pages     :',18,41);
  155.       wFastText('Total phys. pages    :',19,41);
  156.       wFastText('Free linear pages    :',20,41);
  157.       wFastText('Page size            :',21,41);
  158.       FOR i:=1 TO 9 DO
  159.         IF LiAry(MIR)[i]<>-1 THEN
  160.           wFastWrite(LongIntForm('###.###.###', LiAry(MIR)[i]),12+i,66,Cfg.Color[3].FieldColor)
  161.         ELSE
  162.           wFastWrite('N/A',12+i,74,Cfg.Color[3].FieldColor);
  163. {$ENDIF}
  164.     END;
  165.     NewTimerSecs(t, 60);
  166.     REPEAT
  167.       GiveUpTime;
  168.     UNTIL KeyPressed OR ComPort^.KeyPressed OR TimerExpired(t);
  169.     KillWindow(MemWin);
  170.   END;
  171.  
  172. END.
  173.  
  174.